home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / mosmllib / Array.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  6.3 KB  |  194 lines  |  [TEXT/Moml]
  1. (* Array -- new basis 1994-11-21, 1995-05-21 *)
  2.  
  3. abstraction Array : Array = struct
  4.  
  5. (* In fact, type 'a array = 'a array_ ref, but for the static equality
  6.  * type to be right, we need to declare it a prim_EQtype:              *)
  7. prim_EQtype 'a array;
  8.  
  9. local 
  10.     prim_type 'a array_;
  11.  
  12.     type 'a vector = 'a Vector.vector;
  13.  
  14.     prim_val length_  : 'a array_ -> int               = 1 "vect_length";
  15.     prim_val lengthv_ : 'a vector -> int               = 1 "vect_length";
  16.  
  17.     prim_val array_  : int -> 'x -> 'a array_          = 2 "make_ref_vect";
  18.     (* array_ has a non-imperative type for the sake of array0, and a
  19.        very flexible type 'x to allow initialization.  Thus type
  20.        correctness inside this unit body depends on type annotations.
  21.     *)
  22.  
  23.     prim_val vector_ : int -> 'x -> 'a vector          = 2 "make_vect";
  24.     prim_val sub_    : 'a array_ -> int -> 'a          = 2 "get_vect_item";
  25.     prim_val subv_   : 'a vector -> int -> 'a          = 2 "get_vect_item";
  26.     prim_val update_ : 'a array_ -> int -> 'a -> unit  = 3 "set_vect_item";
  27.     prim_val updatev : 'a vector -> int -> 'a -> unit  = 3 "set_vect_item";
  28.  
  29.     prim_val magic   : 'a -> 'b                        = 1 "identity";
  30.  
  31.     fun from_array (a : 'a  array)  = !(magic a)    : 'a array_;
  32.     fun make_array (a : '_a array_) = magic (ref a) : 'a array
  33. in 
  34.  
  35. val maxLen = 4194303;           (* = 2^22-1, for 32-bit architectures *)
  36.  
  37. fun array(n, v : '_a) =
  38.   if n < 0 orelse n > maxLen then raise Size 
  39.   else make_array (array_ n v) : '_a array;
  40.  
  41. fun tabulate(n, f : int -> '_a) =
  42.   if n < 0 orelse n > maxLen then raise Size else
  43.   let val a = array_ n () : '_a array_
  44.       fun init i = if i >= n then () else (update_ a i (f i); init (i+1))
  45.   in (init 0; make_array a : '_a array) end;
  46.  
  47. fun fromList (vs : '_a list) =
  48.     let val n = List.length vs
  49.         val a = if n > maxLen then raise Size
  50.                 else (array_ n () : '_a array_)
  51.         fun init [] i = ()
  52.           | init (v::vs) i = (update_ a i v; init vs (i+1))
  53.     in (init vs 0; make_array a : '_a array) end;
  54.  
  55. fun length a = length_ (from_array a);
  56.  
  57. fun sub(a, i) =
  58.     let val a = from_array a 
  59.     in
  60.         if i < 0 orelse i >= length_ a then raise Subscript 
  61.         else sub_ a i 
  62.     end
  63.  
  64. fun update(a, i, v) =
  65.     let val a = from_array a 
  66.     in
  67.         if i < 0 orelse i >= length_ a then raise Subscript 
  68.         else update_ a i v
  69.     end
  70.  
  71. fun extract (a : 'a array, i, slicelen) =
  72.     let val a = from_array a : 'a array_ 
  73.         val n = case slicelen of NONE => length_ a - i | SOME n => n
  74.         val newvec = if i<0 orelse n<0 orelse i+n > length_ a 
  75.                          then raise Subscript
  76.                      else vector_ n () : 'a vector
  77.         fun copy j = 
  78.             if j<n then
  79.                 (updatev newvec j (sub_ a (i+j)); copy (j+1))
  80.             else
  81.                 ()
  82.     in copy 0; newvec end;
  83.  
  84. fun copy {src=a1: 'a array, si=i1, len, dst=a2: 'a array, di=i2} =
  85.     let val a1 = from_array a1
  86.         and a2 = from_array a2
  87.         val n = case len of NONE => length_ a1 - i1 | SOME k => k
  88.     in
  89.         if n<0 orelse i1<0 orelse i1+n > length_ a1
  90.             orelse i2<0 orelse i2+n > length_ a2
  91.         then 
  92.             raise Subscript
  93.         else if i1 < i2 then            (* copy from high to low *)
  94.                  let fun hi2lo j = 
  95.                      if j >= 0 then
  96.                          (update_ a2 (i2+j) (sub_ a1 (i1+j)); hi2lo (j-1))
  97.                      else ()
  98.                  in hi2lo (n-1) end
  99.              else                       (* i1 >= i2, copy from low to high *)
  100.                  let fun lo2hi j = 
  101.                      if j < n then
  102.                          (update_ a2 (i2+j) (sub_ a1 (i1+j)); lo2hi (j+1))
  103.                      else ()
  104.                  in lo2hi 0 end
  105.     end
  106.  
  107. fun copyVec {src=a1: 'a vector, si=i1, len, dst=a2: 'a array, di=i2} =
  108.     let val a2 = from_array a2
  109.         val n = case len of NONE => lengthv_ a1 - i1 | SOME k => k
  110.     in
  111.         if n<0 orelse i1<0 orelse i1+n > lengthv_ a1
  112.                orelse i2<0 orelse i2+n > length_ a2
  113.             then 
  114.                 raise Subscript
  115.         else 
  116.             let fun lo2hi j = if j < n then
  117.                 (update_ a2 (i2+j) (subv_ a1 (i1+j)); lo2hi (j+1))
  118.                               else ()
  119.             in lo2hi 0 end
  120.     end;
  121.  
  122. fun foldl f e a = 
  123.     let val a = from_array a
  124.         val stop = length_ a
  125.         fun lr j res = if j < stop then lr (j+1) (f(sub_ a j, res))
  126.                        else res
  127.     in lr 0 e end
  128.  
  129. fun foldr f e a =
  130.     let val a = from_array a
  131.         fun rl j res = if j >= 0 then rl (j-1) (f(sub_ a j, res))
  132.                        else res
  133.     in rl (length_ a - 1) e end
  134.  
  135. fun modify f a = 
  136.     let val a = from_array a
  137.         val stop = length_ a
  138.         fun lr j = if j < stop then (update_ a j (f(sub_ a j)); lr (j+1))
  139.                    else ()
  140.     in lr 0 end
  141.  
  142. fun app f a = 
  143.     let val a = from_array a
  144.         val stop = length_ a
  145.         fun lr j = if j < stop then (f(sub_ a j); lr (j+1))
  146.                    else ()
  147.     in lr 0 end
  148.  
  149. fun sliceend (a, i, NONE) = 
  150.         if i<0 orelse i>length a then raise Subscript
  151.         else length a
  152.   | sliceend (a, i, SOME n) = 
  153.         if i<0 orelse n<0 orelse i+n>length a then raise Subscript
  154.         else i+n;
  155.  
  156. fun foldli f e (slice as (a, i, _)) = 
  157.     let val a = from_array a
  158.         fun loop stop =
  159.             let fun lr j res = 
  160.                 if j < stop then lr (j+1) (f(j, sub_ a j, res))
  161.                 else res
  162.             in lr i e end
  163.     in loop (sliceend slice) end;
  164.  
  165. fun foldri f e (slice as (a, i, _)) = 
  166.     let val a = from_array a
  167.         fun loop start =
  168.             let fun rl j res = 
  169.                     if j >= i then rl (j-1) (f(j, sub_ a j, res))
  170.                     else res
  171.             in rl start e end;
  172.     in loop (sliceend slice - 1) end
  173.  
  174. fun modifyi f (slice as (a, i, _)) = 
  175.     let val a = from_array a
  176.         fun loop stop =
  177.             let fun lr j = 
  178.                 if j < stop then (update_ a j (f(j, sub_ a j)); lr (j+1))
  179.                 else ()
  180.             in lr i end
  181.     in loop (sliceend slice) end;
  182.  
  183. fun appi f (slice as (a, i, _)) = 
  184.     let val a = from_array a
  185.         fun loop stop = 
  186.             let fun lr j = 
  187.                     if j < stop then (f(j, sub_ a j); lr (j+1)) 
  188.                     else ()
  189.             in lr i end
  190.     in loop (sliceend slice) end;
  191. end
  192.  
  193. end
  194.